home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Extravaganza - Disc 4
/
Shareware Extravaganza - Over 25,000 Programs (The Ultimate Shareware Company)(Disc 4 of 4)(1993).iso
/
cad
/
quikcmd2.zip
/
SSETS.LSP
< prev
next >
Wrap
Text File
|
1990-10-23
|
7KB
|
240 lines
; SSETS.LSP
;
; QUICK COMMAND version 2.0
; SSETS.LSP is a module of QUICK COMMAND
; Copyright 1989, 1990 Dan Jincks
;
;
; This is SHAREWARE, it is NOT Public Domain software.
;
; This code or any part of this code may not be reproduced
; in any publication without prior written permission.
;
; Printed copy of this code or any part of this code may not
; be distributed without prior written permission.
;
; Printed copy may only be made for reference purposes by
; the end user.
;
;
; Dan Jincks
; Box 155A HCR 77
; Annapolis, MO 63620
;
;
;
; You are granted a limited license to use SSETS.LSP for a 30 day trial
; period. If you wish to continue using any or all of QUICK COMMAND after
; the trial period, you must become a registered user. As a registered
; user, you may use QUICK COMMAND on 1 workstation or terminal.
; Additional registrations must be bought for each additional workstation or
; terminal. To become a registered user, fill out the order form that can
; be printed out from ORDERQC.DOC .
;
;
; You may send copies of QUICK COMMAND to friends and associates if you abide
; by the following rules:
;
; 1. It may only be distributed in the original unmodified form.
; 2. All original files must be included.
; 3. No addition files may be added.
; 4. If other files will be on the same disk, QUICK COMMAND files must be in
; a library format such as ".ARC" called "QUICKCMD", or else be put alone
; in a subdirectory called "QUICKCMD".
; 5. You may not sell QUICK COMMAND or any part of it.
; 6. You are not allowed to charge more then $5 to cover the cost of copying
; and distribution.
; 7. You may not distribute any hard copy of the contents of QUICK COMMAND.
;
;
; These AutoLISP commands and functions are designed to save you time, and
; saving time means saving money. The registration fee is very modest
; compared to the savings, and much less expensive then typical third party
; AutoCAD software. Be sure to registar if you continue to use them.
;
;
; DAN
;
;
;
;
; AutoCAD and AutoLISP are registered trade marks of Autodesk Inc.
;
; ***************************************************************
;
; Begin SSETS.LSP
;
;
(defun C:S1S ()(terpri)
(prompt " Construct selection set SS1 for use in this editing session. . .")
(terpri)
(prompt " Type !SS1 to recall in a command. ")
(terpri)
(setq SS1 (ssget))
)
;
(defun C:S2S ()(terpri)
(prompt " Construct selection set SS2 for use in this editing session. . .")
(terpri)
(prompt " Type !SS2 to recall in a command. ")
(terpri)
(setq SS2 (ssget))
)
;
(defun C:S1A(/ SCE SCA SCB SCC)
(prompt "Select objects to add to set SS1. . . ")(terpri)
(setq SCA (getvar "blipmode"))
(setvar "blipmode" 1)
(setvar "cmdecho" 0)
(command "select" SS1)
(setq SCB 0)
(setq SCC (ssget))
(command "")
(setq SCE (ssname SCC SCB))
(while (/= SCE nil)(progn
(ssadd SCE SS1)
(setq SCB (1+ SCB))
(setq SCE (ssname SCC SCB))
)
)
(prompt "New SS1 is highlighted... Press <ENTER>")
(command "select" SS1 pause)
(setvar "cmdecho" 1)
(setvar "blipmode" SCA)(princ)
)
;
(defun C:S2A(/ SCE SCA SCB SCC)
(prompt "Select objects to add to set SS2. . . ")(terpri)
(setq SCA (getvar "blipmode"))
(setvar "blipmode" 1)
(setvar "cmdecho" 0)
(command "select" SS2)
(setq SCB 0)
(setq SCC (ssget))
(command "")
(setq SCE (ssname SCC SCB))
(while (/= SCE nil)(progn
(ssadd SCE SS2)
(setq SCB (1+ SCB))
(setq SCE (ssname SCC SCB))
)
)
(prompt "New SS2 is highlighted... Press <ENTER>")
(command "select" SS2 pause)
(setvar "cmdecho" 1)
(setvar "blipmode" SCA)(princ)
)
;
(defun C:S1R(/ SCE SCA)
(prompt "Pick objects to remove from set SS1. . . ") (terpri)
(setq SCA (getvar "blipmode"))
(setvar "blipmode" 1)
(setvar "cmdecho" 0)
(command "select" SS1)
(setq SCE (entsel))
(while (/= SCE nil)(progn
(command "")
(setq SCE (car SCE))
(ssdel SCE SS1)
(command "select" SS1)
(setq SCE (entsel))
)
)
(command "")
(setvar "cmdecho" 1)
(setvar "blipmode" SCA)
)
;
(defun C:S2R(/ SCE SCA)
(prompt "Pick objects to remove from set SS2. . . ") (terpri)
(setq SCA (getvar "blipmode"))
(setvar "blipmode" 1)
(setvar "cmdecho" 0)
(command "select" SS2)
(setq SCE (entsel))
(while (/= SCE nil)(progn
(command "")
(setq SCE (car SCE))
(ssdel SCE SS2)
(command "select" SS2)
(setq SCE (entsel))
)
)
(command "")
(setvar "cmdecho" 1)
(setvar "blipmode" SCA)
)
;
(defun C:S1H (/ SCA)
(setq SCA (getvar "cmdecho"))
(setvar "cmdecho" 0)
(prompt "Selection set SS1 is highlighted... Press ENTER ")
(command "select" SS1 pause )
(setvar "cmdecho" SCA)
)
(defun C:S2H (/ SCA)
(setq SCA (getvar "cmdecho"))
(setvar "cmdecho" 0)
(prompt "Selection set SS2 is highlighted... Press ENTER ")
(command "select" SS2 pause )
(setvar "cmdecho" SCA)
)
;
(defun C:S2F1 (/ SCA SCB SCC SCD SCE)
(setvar "cmdecho" 0)
(command "select" SS1)
(initget 1 "Line Circle Point POLyline Arc Text")
(setq SCA (strcase (getkword "Type of entity in SS1 to be put into SS2.
Line, Circle, Arc, Point, Text or POLyline... ")))(terpri)
(prompt " working... please wait... ")(terpri)
(command "")
(if (= SS2 nil)(progn
(setq SS2 (ssadd))))
(setq SCC 0)
(setq SCE (ssname SS1 SCC))
(while (/= SCE nil)(progn
(setq SCB (entget SCE ))
(setq SCD (cdr (assoc 0 SCB)))
(if (= SCD SCA)(progn
(ssadd SCE SS2)
)
)
(setq SCC (1+ SCC))
(setq SCE (ssname SS1 SCC))
(if (= SCE nil)(progn
(prompt " Done... SS2 is highlighted... Press enter to continue ")
(command "select" SS2 pause )
(setvar "cmdecho" 1)))
))(princ)
)
;
(defun C:S1F2 (/ SCA SCB SCC SCD SCE)
(setvar "cmdecho" 0)
(command "select" SS2)
(initget 1 "Line Circle Point POLyline Arc Text")
(setq SCA (strcase (getkword "Type of entity in SS2 to be put into SS1.
Line, Circle, Arc, Point, Text or POLyline... ")))(terpri)
(prompt " working... please wait... ")(terpri)
(command "")
(if (= SS1 nil)(progn
(setq SS1 (ssadd))))
(setq SCC 0)
(setq SCE (ssname SS2 SCC))
(while (/= SCE nil)(progn
(setq SCB (entget SCE))
(setq SCD (cdr (assoc 0 SCB)))
(if (= SCD SCA)(progn
(ssadd SCE SS1)
)
)
(setq SCC (1+ SCC))
(setq SCE (ssname SS2 SCC))
(if (= SCE nil)(progn
(prompt " Done... SS1 is highlighted... Press enter to continue ")
(command "select" SS1 pause )
(setvar "cmdecho" 1)))
))(princ)
)
;
; End SSETS.LSP